library(tidyverse)
-- Attaching packages -------------------------------------------------------------------------------------------------------------------- tidyverse 1.3.0 --
v tibble  3.1.0     v stringr 1.4.0
v readr   1.4.0     v forcats 0.5.1
-- Conflicts ----------------------------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
x purrr::%||%()       masks flexclust.golem::%||%()
x purrr::accumulate() masks foreach::accumulate()
x dplyr::filter()     masks stats::filter()
x purrr::is_null()    masks testthat::is_null()
x dplyr::lag()        masks stats::lag()
x tidyr::matches()    masks dplyr::matches(), testthat::matches()
x MASS::select()      masks dplyr::select()
x purrr::when()       masks foreach::when()
library(flexclust)
library(flexclust.golem)
params$solutions
flexclust.golem::plot_profile(params$solutions,1)
plot_profile...
class solutions:tbl_dftbldata.frame
class solutions$fit_km:list
class solutions$fit_km[1]:list
class solutions$fit_km[1][[1]]:kcca
i = 1
NULL

  i=1
  this_solution = params$solutions$fit_km[i][[1]]
  k <- this_solution@k
  seed = params$solutions$seed[i]
  pop_av_dist <- with(this_solution@clusinfo, sum(size*av_dist)/sum(size))
  main_txt <- paste("kcca ", "Av Dist = ", format(pop_av_dist, digits = 5), params$method, " - ",k,"seed=",seed)
  
  label_clust <- hclust(dist(t(as.matrix(data_df))))
  
  barchart(this_solution, 
           which=label_clust$order,
           main = main_txt, strip.prefix = "#",
           scales = list(cex = 0.6),
           shade = TRUE,
           legend = TRUE,
           clusters=5:6
  )
NULL

  this_solution
kcca object of family ‘ejaccard’ 

call:
flexclust::stepFlexclust(x = as.matrix(data_df), k = 6L, nrep = km_nrep, FUN = flexclust::kcca, seed = seed, multicore = FALSE, 
    family = flexclust::kccaFamily(method))

cluster sizes:

  1   2   3   4   5   6 
362 434  92 343 227 542 
var_labels
 [1] "cash_1"                                 "platform_unknown"                       "shop_before_covid_1"                   
 [4] "person_marital_status_unknown"          "tenure_group_0_1"                       "site_type_shop"                        
 [7] "enroll_site_type_shop"                  "weekend_1"                              "age_group_30_40"                       
[10] "tenure_group_5_10"                      "site_type_migration"                    "enroll_site_type_migration"            
[13] "age_group_40_50"                        "tenure_group_3_5"                       "discount_3_20_percent_30_percent"      
[16] "annual_spend_3_2mn_3mn"                 "discount_4_30_percent_40_percent"       "age_group_12_20"                       
[19] "person_gender_m"                        "annual_spend_4_3mn_5mn"                 "tenure_group_10_20"                    
[22] "age_group_50_60"                        "pay_with_points_4_more_than_124_points" "annual_spend_5_5mn_10mn"               
[25] "discount_5_40_percent_50_percent"       "site_type_mobile_apps"                  "enroll_site_type_mobile_apps"          
[28] "platform_i_phone_os"                    "pay_with_points_2_31_59_points"         "bazar_before_covid_1"                  
[31] "bazar_1"                                "traveller_1"                            "discount_6_above_50_percent"           
[34] "age_group_unknown"                      "site_type_online"                       "enroll_site_type_online"               
[37] "site_type_test_market"                  "enroll_site_type_test_market"           "petition_1"                            
[40] "annual_spend_6_above_10mn"              "reach_tbs_voice_1"                      "bazar_after_covid_1"                   
[43] "age_group_60_100"                       "others_1"                               "reach_tbs_webchat_1"                   
[46] "posted_reviews_1"                       "annual_spend_unknown"                   "pay_with_points_unknown"               
[49] "discount_unknown"                       "reach_tbs_wa_1"                         "pay_with_points_3_60_124_points"       
[52] "abandon_basket_1"                       "online_before_covid_1"                  "credit_1"                              
[55] "bbob_1"                                 "point_redeemer_1"                       "tenure_group_1_3"                      
[58] "discount_2_10_percent_20_percent"       "annual_spend_2_1mn_2mn"                 "donation_1"                            
[61] "sustainability_score_1"                 "debit_1"                                "shop_after_covid_1"                    
[64] "person_marital_status_single"           "online_after_covid_1"                   "working_1"                             
[67] "age_group_20_30"                       
plot_data %>% 
  ggplot() +
  geom_point(aes(x=variable, y=all),col="black") +
  geom_segment(aes(x=variable, y=0, xend=variable, yend=all),col="black") +
  geom_col(aes(x=variable, y=solution, fill=I(shade)),alpha=0.5) +
  coord_flip() +
  facet_wrap(~segment) +
  ylab("Proportion of Segment") 

ggplot(data=plot_data %>% filter(part == "all", segment=="1"), aes(x=variable,y=value)) + 
  geom_col() + 
  geom_point(data=plot_data %>% filter(part == "solution", segment=="1"), aes(x=variable, y=value)) +
  geom_segment(data=plot_data %>% filter(part == "solution", segment=="1"), aes(x=variable, y=0, xend=variable, yend=value)) +
  facet_wrap(~segment) + coord_flip()

LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpgYGB7cn0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShmbGV4Y2x1c3QpDQpsaWJyYXJ5KGZsZXhjbHVzdC5nb2xlbSkNCmBgYA0KDQpgYGB7cn0NCnBhcmFtcyRkYXRhDQpgYGANCg0KYGBge3J9DQpwYXJhbXMkc29sdXRpb25zDQpgYGANCg0KYGBge3IgaGVpZ2h0PTIwLHdpZHRoPTYwfQ0KZmxleGNsdXN0LmdvbGVtOjpwbG90X3Byb2ZpbGUocGFyYW1zJHNvbHV0aW9ucywxKQ0KYGBgDQpgYGB7cn0NCiAgaT0xDQogIHRoaXNfc29sdXRpb24gPSBwYXJhbXMkc29sdXRpb25zJGZpdF9rbVtpXVtbMV1dDQogIGsgPC0gdGhpc19zb2x1dGlvbkBrDQogIHNlZWQgPSBwYXJhbXMkc29sdXRpb25zJHNlZWRbaV0NCiAgcG9wX2F2X2Rpc3QgPC0gd2l0aCh0aGlzX3NvbHV0aW9uQGNsdXNpbmZvLCBzdW0oc2l6ZSphdl9kaXN0KS9zdW0oc2l6ZSkpDQogIG1haW5fdHh0IDwtIHBhc3RlKCJrY2NhICIsICJBdiBEaXN0ID0gIiwgZm9ybWF0KHBvcF9hdl9kaXN0LCBkaWdpdHMgPSA1KSwgcGFyYW1zJG1ldGhvZCwgIiAtICIsaywic2VlZD0iLHNlZWQpDQogIA0KICBsYWJlbF9jbHVzdCA8LSBoY2x1c3QoZGlzdCh0KGFzLm1hdHJpeChkYXRhX2RmKSkpKQ0KICANCiAgYmFyY2hhcnQodGhpc19zb2x1dGlvbiwgDQogICAgICAgICAgIHdoaWNoPWxhYmVsX2NsdXN0JG9yZGVyLA0KICAgICAgICAgICBtYWluID0gbWFpbl90eHQsIHN0cmlwLnByZWZpeCA9ICIjIiwNCiAgICAgICAgICAgc2NhbGVzID0gbGlzdChjZXggPSAwLjYpLA0KICAgICAgICAgICBzaGFkZSA9IFRSVUUsDQogICAgICAgICAgIGxlZ2VuZCA9IFRSVUUsDQogICAgICAgICAgIGNsdXN0ZXJzPTU6Ng0KICApDQpgYGANCmBgYHtyfQ0KY2x1c3Rlcl9kYXRhX2JhbGFuY2VkICU+JSBqYW5pdG9yOjpjbGVhbl9uYW1lcygpIC0+IGNsdXN0ZXJfZGF0YV9iYWxhbmNlZA0KYGBgDQoNCg0KYGBge3J9DQpsYWJlbF9vcmRlciA9IGhjbHVzdChkaXN0KHQoYXMubWF0cml4KGNsdXN0ZXJfZGF0YV9iYWxhbmNlZCkpKSkNCmxhYmVsX29yZGVyJG9yZGVyDQpsZW5ndGgobGFiZWxfb3JkZXIkb3JkZXIpDQp2YXJfbGFiZWxzID0gY29sbmFtZXMoY2x1c3Rlcl9kYXRhX2JhbGFuY2VkKVtsYWJlbF9vcmRlciRvcmRlcl0NCmxlbmd0aCh2YXJfbGFiZWxzKQ0KdmFyX2xhYmVscw0KYGBgDQoNCmBgYHtyfQ0KYmluZF9yb3dzKA0KICB0aGlzX3NvbHV0aW9uQHhjZW50ICU+JSBhc190aWJibGVfcm93KCkgJT4lIGphbml0b3I6OmNsZWFuX25hbWVzKCkgJT4lIHNsaWNlKHJlcCgxOm4oKSwgZWFjaD02KSkgJT4lIGFkZF9jb2x1bW4oc2VnbWVudCA9IDE6NiwgcGFydD0iYWxsIikgICwNCiAgdGhpc19zb2x1dGlvbkBjZW50ZXJzICU+JSBhc190aWJibGUoKSAlPiUgamFuaXRvcjo6Y2xlYW5fbmFtZXMoKSAlPiUgYWRkX2NvbHVtbihzZWdtZW50PSAxOjYsIHBhcnQ9InNvbHV0aW9uIikNCikgJT4lIA0KICBwaXZvdF9sb25nZXIoY29scz0xOjY3LCBuYW1lc190bz0idmFyaWFibGUiLCB2YWx1ZXNfdG8gPSAidmFsdWUiKSAlPiUgDQogIHBpdm90X3dpZGVyKGlkX2NvbHMgPSBjKHZhcmlhYmxlLHNlZ21lbnQscGFydCksIG5hbWVzX2Zyb20gPSBwYXJ0LCB2YWx1ZXNfZnJvbT12YWx1ZSkgJT4lIA0KICBtdXRhdGUoDQogICAgdmFyX2xhYmVsID0gZmFjdG9yKHZhcmlhYmxlLCBsZXZlbHM9dmFyX2xhYmVscyksDQogICAgZGlmZiA9IGFsbCAtIHNvbHV0aW9uLA0KICAgIGFic19kaWZmID0gYWJzKGRpZmYpLA0KICAgIGFic19wcm9wX2RpZmYgPSBhYnMoZGlmZi9hbGwpLA0KICAgIHNpZ25pZiA9IGlmX2Vsc2UoYWJzX2RpZmYgPiAwLjUgfCBhYnNfcHJvcF9kaWZmID4gMC4yNSwgVFJVRSwgRkFMU0UpLA0KICAgIHNoYWRlID0gbWFwMl9jaHIoc2lnbmlmLCBzZWdtZW50LH5mbGV4Y2x1c3Q6OmZseENvbG9ycyhuPS55LCBncmV5PSEueCkpDQogICAgKSAtPiBwbG90X2RhdGENCnBsb3RfZGF0YSAlPiUgVmlldygpDQpgYGANCg0KYGBge3IgZmlnLmhlaWdodD0xMH0NCnBsb3RfZGF0YSAlPiUgDQogIGdncGxvdCgpICsNCiAgZ2VvbV9wb2ludChhZXMoeD12YXJpYWJsZSwgeT1hbGwpLGNvbD0iYmxhY2siKSArDQogIGdlb21fc2VnbWVudChhZXMoeD12YXJpYWJsZSwgeT0wLCB4ZW5kPXZhcmlhYmxlLCB5ZW5kPWFsbCksY29sPSJibGFjayIpICsNCiAgZ2VvbV9jb2woYWVzKHg9dmFyaWFibGUsIHk9c29sdXRpb24sIGZpbGw9SShzaGFkZSkpLGFscGhhPTAuNSkgKw0KICBjb29yZF9mbGlwKCkgKw0KICBmYWNldF93cmFwKH5zZWdtZW50KSArDQogIHlsYWIoIlByb3BvcnRpb24gb2YgU2VnbWVudCIpIA0KDQpgYGANCg0KYGBge3J9DQpwbG90X2RhdGEgJT4lIA0KICBmaWx0ZXIoc3RyX3N0YXJ0cyh2YXJpYWJsZSwiYWdlIikpICU+JSANCiAgZ2dwbG90KCkgKw0KICBnZW9tX3BvaW50KGFlcyh4PXZhcmlhYmxlLCB5PWFsbCksY29sPSJibGFjayIpICsNCiAgZ2VvbV9zZWdtZW50KGFlcyh4PXZhcmlhYmxlLCB5PTAsIHhlbmQ9dmFyaWFibGUsIHllbmQ9YWxsKSxjb2w9ImJsYWNrIikgKw0KICBnZW9tX2NvbChhZXMoeD12YXJpYWJsZSwgeT1zb2x1dGlvbiwgZmlsbD1JKHNoYWRlKSksYWxwaGE9MC41KSArDQogIGNvb3JkX2ZsaXAoKSArDQogIGZhY2V0X3dyYXAofnNlZ21lbnQpICsNCiAgeWxhYigiUHJvcG9ydGlvbiBvZiBTZWdtZW50IikgDQoNCmBgYA0KDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGE9cGxvdF9kYXRhICU+JSBmaWx0ZXIocGFydCA9PSAiYWxsIiwgc2VnbWVudD09IjEiKSwgYWVzKHg9dmFyaWFibGUseT12YWx1ZSkpICsgDQogIGdlb21fY29sKCkgKyANCiAgZ2VvbV9wb2ludChkYXRhPXBsb3RfZGF0YSAlPiUgZmlsdGVyKHBhcnQgPT0gInNvbHV0aW9uIiwgc2VnbWVudD09IjEiKSwgYWVzKHg9dmFyaWFibGUsIHk9dmFsdWUpKSArDQogIGdlb21fc2VnbWVudChkYXRhPXBsb3RfZGF0YSAlPiUgZmlsdGVyKHBhcnQgPT0gInNvbHV0aW9uIiwgc2VnbWVudD09IjEiKSwgYWVzKHg9dmFyaWFibGUsIHk9MCwgeGVuZD12YXJpYWJsZSwgeWVuZD12YWx1ZSkpICsNCiAgZmFjZXRfd3JhcCh+c2VnbWVudCkgKyBjb29yZF9mbGlwKCkNCmBgYA0KDQoNCmBgYHtyfQ0KYmFyY2hhcnQodGhpc19zb2x1dGlvbiwgDQogICAgICAgICB3aGljaD0iYWdlX2dyb3VwXygxMiwyMF0iLA0KICAgICAgICAgbWFpbiA9IG1haW5fdHh0LCBzdHJpcC5wcmVmaXggPSAiIyIsDQogICAgICAgICBzY2FsZXMgPSBsaXN0KGNleCA9IDAuNiksDQogICAgICAgICBzaGFkZSA9IFRSVUUsDQogICAgICAgICBsZWdlbmQgPSBUUlVFLA0KICAgICAgICAgYnl2YXI9VFJVRQ0KKQ0KYGBgDQoNCg==